'--------------------------------------------------------------------------------
' Globals
'--------------------------------------------------------------------------------
GLOBAL shortWeekDay()   AS STRING ' (1 TO 7)  : e.g. Mon, Tue, Wed...
GLOBAL longWeekDay()    AS STRING ' (1 TO 7)  : e.g. Monday, Tuesday...
GLOBAL shortMonthName() AS STRING ' (1 TO 12) : e.g. JAN, FEB, MAR...
GLOBAL longMonthName()  AS STRING ' (1 TO 12) : e.g. January, February...
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function DateStr returns a date according to a format string
'--------------------------------------------------------------------------------
' w     short weekday name (3 characters) e.g. Mon, Tue, Wed...
' wd    full weekday name e.g. Monday, Tuesday...
' wn    week number
' d     short day number (1 or 2 digits)
' dd    long day number (2 digits, prefixed with '0')
' m     short month number (1 or 2 digits)
' mm    long month number (2 digits, prefixed with '0')
' M     short month name (3 characters) e.g. JAN, FEB, MAR...
' MM    long month name e.g. January, February...
' yy    short year number (2 digits)
' yyyy  long year number (4 digits)
'--------------------------------------------------------------------------------
FUNCTION DateStr(BYVAL year AS LONG, _
                 BYVAL month AS LONG, _
                 BYVAL day AS LONG, _
                 BYVAL format AS STRING) AS STRING
    LOCAL i, j, k   AS LONG
    LOCAL wn, dow   AS LONG
    LOCAL r         AS STRING

    REDIM PRESERVE shortWeekDay(1 TO 7)
    REDIM PRESERVE longWeekDay(1 TO 7)
    REDIM PRESERVE shortMonthName(1 TO 12)
    REDIM PRESERVE longMonthName(1 TO 12)

    IF shortWeekDay(1) = "" THEN ARRAY ASSIGN shortWeekDay() _
        = "lun", "mar", "mer", "jeu", "ven", "sam", "dim"
    IF longWeekDay(1) = "" THEN ARRAY ASSIGN longWeekDay() _
        = "lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche"
    IF shortMonthName(1) = "" THEN ARRAY ASSIGN shortMonthName() _
        = "JAN", "FEV", "MAR", "AVR", "MAI", "JUN", "JUL", "AOU", "SEP", "OCT", "NOV", "DEC"
    IF longMonthName(1) = "" THEN ARRAY ASSIGN longMonthName() _
        = "janvier", "février", "mars", "avril", "mai", "juin", "juillet", _
          "août", "septembre", "octobre", "novembre", "décembre"

    wn  = WeekNb(year, month, day)
    dow = DayOfWeek(year, month, day)

    ' Protect keywords with curled braces
    r = format
    REPLACE "wn"    WITH "{WN}" IN r ' week number
    REPLACE "wd"    WITH "{LW}" IN r ' long weekday
    REPLACE "w"     WITH "{SW}" IN r ' short weekday
    REPLACE "dd"    WITH "{LD}" IN r ' long day number
    REPLACE "d"     WITH "{SD}" IN r ' short day number
    REPLACE "mm"    WITH "{L#}" IN r ' long month number
    REPLACE "m"     WITH "{S#}" IN r ' short month number
    REPLACE "MM"    WITH "{LO}" IN r ' long month name
    REPLACE "M"     WITH "{SH}" IN r ' short month name
    REPLACE "yyyy"  WITH "{Y4}" IN r ' year on 4 digits
    REPLACE "YYYY"  WITH "{Y4}" IN r ' be a little permissive: YYYY=yyyy
    REPLACE "yy"    WITH "{Y2}" IN r ' year on 2 digits
    REPLACE "YY"    WITH "{Y2}" IN r ' be a little permissive: YY=yy

    ' Now, replace protected keywords with their values
    REPLACE "{WN}" WITH TRIM$(STR$(wn)) IN r
    REPLACE "{LW}" WITH longWeekDay(dow) IN r
    REPLACE "{SW}" WITH shortWeekDay(dow) IN r
    REPLACE "{LD}" WITH FORMAT$(day, "00") IN r
    REPLACE "{SD}" WITH TRIM$(STR$(day)) IN r
    REPLACE "{L#}" WITH FORMAT$(month, "00") IN r
    REPLACE "{S#}" WITH TRIM$(STR$(month)) IN r
    REPLACE "{LO}" WITH longMonthName(month) IN r
    REPLACE "{SH}" WITH shortMonthName(month) IN r
    REPLACE "{Y4}" WITH TRIM$(STR$(year)) IN r
    REPLACE "{Y2}" WITH RIGHT$(TRIM$(STR$(year)), 2) IN r

    FUNCTION = r
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function Julian - returns Julian Day Number (JDN)
' Actually it counts days elapsed since "11/25/-4713" (= Nov. 25, 4714 BCE)
'--------------------------------------------------------------------------------
FUNCTION Julian(BYVAL year AS LONG, _
                BYVAL month AS LONG, _
                BYVAL day AS LONG) AS LONG

  LOCAL Days AS LONG, yearsBC AS LONG, yearsAD AS LONG

  IF month < 3 THEN                               ' January or February?
    month = month + 12                            ' 13th or 14th month ....
    DECR year                                     ' .... of prev. year
  END IF

  yearsBC = 4714 - 1                              ' 4713 BC thru 1 BC
  yearsAD = year - 1                              ' 1 AD thru (year of date minus 1)
  Days = INT((yearsBC + yearsAD) * 365.25)        ' calculate days in years
  Days = Days - (year \ 100)                      ' substract century leapdays
  Days = Days + (year \ 400)                      ' re-add valid ones
  Days = Days + INT(30.6 * (month - 1) + .2)      ' days in months elapsed (+ adjustment)
  FUNCTION = Days + day                           ' days in month of date
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function Julian2Date - returns a date "yyyymmdd" from a Julian Day Number (JDN)
'--------------------------------------------------------------------------------
FUNCTION Julian2Date(BYVAL jd AS LONG) AS STRING
    LOCAL q, r, s, t, u, v, d, cond, m, y AS LONG
    LOCAL yr, mo, da AS STRING

    q =  INT((jd / 36524.25) - 51.12264)
    r = jd + q - INT(q / 4) + 1
    s = r + 1524
    t = INT((s / 365.25) - 0.3343)
    u = INT(t * 365.25)
    v = INT((s - u) / 30.61)
    d = s - u - INT(v * 30.61)
    IF v > 13.5 THEN cond = -1 ELSE cond = 0
    m = (v - 1) + 12 * cond
    IF m < 2.5 THEN cond = -1 ELSE cond = 0
    y = t - cond - 4716

    yr = TRIM$(STR$(y)) : WHILE LEN(yr) < 4 : yr = "0" + yr : WEND
    mo = TRIM$(STR$(m)) : IF LEN(mo) < 2 THEN mo = "0" + mo
    da = TRIM$(STR$(d)) : IF LEN(da) < 2 THEN da = "0" + da

    FUNCTION = yr + mo + da
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function JulianDayOfWeek returns day of the week (Mon=1..Sun=7)
'--------------------------------------------------------------------------------
FUNCTION JulianDayOfWeek(JDN AS LONG) AS BYTE
  FUNCTION = JDN MOD 7 + 1
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function DayOfWeek same than above with different input format
'--------------------------------------------------------------------------------
FUNCTION DayOfWeek(BYVAL year AS LONG, _
                   BYVAL month AS LONG, _
                   BYVAL day AS LONG) AS BYTE

  LOCAL JD AS LONG

  JD = Julian(year, month, day)
  FUNCTION = JulianDayOfWeek(JD)

END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function WeekOne returns first day of first week for the given year
' Note: This is only a helper function for WeekNbStr
'--------------------------------------------------------------------------------
FUNCTION WeekOne(BYVAL year AS LONG) AS LONG
  LOCAL temp AS LONG, Thursday AS BYTE
  Thursday = 4
  temp = Julian(year,1,1) - 1                  ' Dec. 31 of prev. year
  DO
    INCR temp
  LOOP UNTIL JulianDayOfWeek(temp) = Thursday  ' until first Thursday of year is found
  FUNCTION = temp - 3                          ' first day of first week is a Monday
END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function WeekNb returns ISO-proof weeknumber for a date
'--------------------------------------------------------------------------------
FUNCTION WeekNb(BYVAL year AS LONG, _
                BYVAL month AS LONG, _
                BYVAL day AS LONG) AS BYTE

  LOCAL FirstDay AS LONG, FinalDay AS LONG, ToDay AS LONG

  FirstDay = WeekOne(year)
  FinalDay = WeekOne(year + 1) - 1
  ToDay    = Julian(year, month, day)
  SELECT CASE ToDay
    CASE < FirstDay
      ' it is week 52 or 53, but which one?
      ' therefore we need week one of previous year as a starting point
      FirstDay = WeekOne(year - 1)
    CASE > FinalDay
      ' there is only one possibility: week nbr 1
      FUNCTION = 1
      EXIT FUNCTION
  END SELECT
  FUNCTION = ((ToDay - FirstDay) \ 7) + 1

END FUNCTION
'--------------------------------------------------------------------------------

'--------------------------------------------------------------------------------
' Function EasterDate returns Easter day in March (or in April if > 31) for a year
'--------------------------------------------------------------------------------
FUNCTION EasterDate(BYVAL DDPyear AS LONG) AS LONG
    LOCAL year, g, c, c4, e, h, k, p, q, i, b, j1, j2 AS LONG
    year = DDPyear
    g = year MOD 19
    c = INT(year / 100)
    c4 = INT(c / 4)
    e = INT((8 * c + 13) / 25)
    h = (19 * g + c - c4 - e + 15) MOD 30
    k = INT(h / 28)
    p = INT(29 / (h + 1))
    q = INT(21 - g) / 11
    i = (k * p * q - 1) * k + h
    b = INT(year / 4) + year
    j1 = b + i + 2 + c4 - c
    j2 = j1 MOD 7
    FUNCTION = 28 + i - j2
END FUNCTION
'--------------------------------------------------------------------------------